home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / magazi~1 / 404 / mshow_it.lst < prev    next >
Encoding:
File List  |  1989-07-02  |  6.0 KB  |  291 lines
  1. '
  2. ' *********************************************************************
  3. '                              S H O W   I T !
  4. '                           A Slide Show Program
  5. '                            for Young Children
  6. '                    yet another kidprg in GFA Basic from
  7. '                               D.A. Brumleve
  8. '                         Copyright 1989 by ST-LOG
  9. ' **********************************************************************
  10. '                               Monochrome
  11. '                               Version 1.6
  12. '                            February 16, 1989
  13. ' **********************************************************************
  14. '                                REFERENCE
  15. ' **********************************************************************
  16. ' VARIABLES
  17. ' Aa%
  18. ' Alrt$
  19. ' Ax%
  20. ' Ay%
  21. ' Bb%
  22. ' Button%
  23. ' Cc%
  24. ' Dummy%
  25. ' Dur%
  26. ' First_time%
  27. ' G%
  28. ' I%
  29. ' K%
  30. ' Main_screen$
  31. ' Mk%
  32. ' Mx%
  33. ' My%
  34. ' N%
  35. ' Nt%
  36. ' Oct%
  37. ' Palette%()
  38. ' Pic$()
  39. ' Rez%
  40. ' Sg%
  41. ' Ss%
  42. ' Stx%
  43. ' Sty%
  44. ' Yes%
  45. ' Z$
  46. '
  47. ' **************************** INITIALIZATION ************************
  48. Dim Palette%(1),Pic$(6)
  49. @Check_rez
  50. @Save_palette
  51. If Not Exist("MDRAWIT!.DAT")
  52.   Alrt$="  |There are no DRAW IT! pictures|on this disk!"
  53.   Alert 3,Alrt$,1,"Oops...",Dummy%
  54.   Cls
  55.   @Restore_palette
  56.   End
  57. Endif
  58. @Set_color
  59. Hidem
  60. Graphmode 2
  61. Cls
  62. For I%=1 To 5
  63.   Get 0,112,638,398,Pic$(I%)
  64. Next I%
  65. Cls
  66. @Title
  67. K%=Xbios(35,15,0)
  68. I%=1
  69. First_time%=0
  70. Repeat
  71. Until Inkey$=""
  72. ' ***************************** MAIN PROGRAM ***************************
  73. Top:
  74. Repeat
  75.   Mouse Ax%,Ay%,Button%
  76.   Z$=Inkey$
  77.   If Z$<>""
  78.     First_time%=1
  79.     Put 0,112,Pic$(I%)
  80.     @Select_sound
  81.     Repeat
  82.     Until Inkey$=""
  83.     Inc I%
  84.     If I%>5
  85.       I%=1
  86.     Endif
  87.   Endif
  88. Until Button%>0
  89. Sget Main_screen$
  90. @Let_go
  91. @Exit_routine
  92. Hidem
  93. If Yes%=0
  94.   Sput Main_screen$
  95.   Goto Top
  96. Else
  97.   Sput Main_screen$
  98.   @Finale_sound
  99.   Cls
  100.   @Restore_palette
  101.   K%=Xbios(35,7,7)
  102.   End
  103. Endif
  104. '
  105. ' *************************** DISK ACTIVITIES **************************
  106. Procedure Load_it
  107.   Open "I",#1,"MDRAWIT!.DAT"
  108.   For I%=1 To 5
  109.     Bget #1,Varptr(Pic$(I%)),Len(Pic$(I%))
  110.   Next I%
  111.   Close #1
  112. Return
  113. '
  114. ' ********************************* SCREENS *******************************
  115. Procedure Title
  116.   G%=125
  117.   Sg%=75
  118.   Deftext 1,1,0,32
  119.   Text 198,40,"S H O W   I T !"
  120.   Deftext 1,1,0,13
  121.   Text 70+G%,70,"     A Slide Show Program"
  122.   Text 70+G%,90,"      for Young Children"
  123.   Deffill 0
  124.   Pbox 0,112,638,398
  125.   Ss%=50
  126.   Deftext 1,1,0,6
  127.   Text 90+Sg%,70+Ss%,"YET ANOTHER KIDPRG  IN GFA BASIC FROM"
  128.   Deftext 1,0,0,6
  129.   Text 310,70+Ss%,Chr$(191)
  130.   Deftext 1,0,0,13
  131.   Text 70+G%,90+Ss%,"         D.A. Brumleve"
  132.   Deftext 1,5,0,6
  133.   Text 120+Sg%,108+Ss%,"                      ST-LOG"
  134.   Deftext 1,1,0,6
  135.   Text 120+Sg%,108+Ss%,"    COPYRIGHT 1989 BY"
  136.   Deftext 1,1,0,6
  137.   Text 102+Sg%,126+Ss%,"       MONOCHROME VERSION 1.6"
  138.   Ss%=40
  139.   Deftext 1,1,0,13
  140.   Text 52+G%,170+Ss%," For use with files created with"
  141.   Text 66+G%,200+Ss%,"            DRAW IT!"
  142.   Text 45+G%,230+Ss%,"As published originally in        !"
  143.   Sty%=92+Ss%
  144.   Stx%=-12
  145.   Color 1
  146.   Box 408+Stx%,104+Sty%,448+Stx%,146+Sty%
  147.   Color 0
  148.   Box 410+Stx%,106+Sty%,446+Stx%,144+Sty%
  149.   Deffill 0,2,8
  150.   Pbox 410+Stx%,132+Sty%,446+Stx%,144+Sty%
  151.   Deffill 1,2,8
  152.   Pbox 412+Stx%,108+Sty%,444+Stx%,130+Sty%
  153.   Deftext 0,1,0,32
  154.   Text 414+Stx%,130+Sty%," T"
  155.   Text 410+Stx%,130+Sty%,"S"
  156.   Deftext 1,1,0,6
  157.   Text 421+Stx%,142+Sty%,"  G"
  158.   Text 416+Stx%,142+Sty%," O"
  159.   Text 411+Stx%,142+Sty%,"L"
  160.   @Load_it
  161.   Deffill 1
  162.   Pbox 20,300,618,398
  163.   Deffill 0
  164.   Pbox 24,304,614,394
  165.   Deffill 1
  166.   Pbox 28,308,610,390
  167.   Deftext 0,1,0,13
  168.   Text 69+G%,334,"Press any key to show a picture."
  169.   Text 61+G%,374,"  Press a mouse button to quit."
  170. Return
  171. '
  172. ' *************************** WATCH THE MOUSE *************************
  173. Procedure Let_go
  174.   Repeat
  175.     Mouse Mx%,My%,Mk%
  176.   Until Mk%=0
  177. Return
  178. '
  179. Procedure Check_target
  180.   Repeat
  181.     Mouse Aa%,Bb%,Cc%
  182.   Until Cc%>0 And Bb%>240 And Bb%<340 And ((Aa%>398 And Aa%<538) Or (Aa%>100 And Aa%<240))
  183.   Deffill 0,2,8
  184.   If Aa%>398 And Aa%<538
  185.     Yes%=0
  186.     Fill 396,238
  187.   Else
  188.     Yes%=1
  189.     Fill 98,238
  190.   Endif
  191.   @Alert_sound
  192.   @Let_go
  193.   Pause 25
  194. Return
  195. '
  196. ' **************************** COLOR PALETTE **************************
  197. Procedure Check_rez
  198.   Rez%=Xbios(4)
  199.   If Rez%<>2
  200.     Alrt$=" |This version of SHOW IT!|requires High Resolution."
  201.     Alert 3,Alrt$,1,"Oops!",Dummy%
  202.     End
  203.   Endif
  204. Return
  205. '
  206. Procedure Save_palette
  207.   For I%=0 To 1
  208.     Palette%(I%)=Xbios(7,W:I%,W:-1)
  209.   Next I%
  210. Return
  211. '
  212. Procedure Restore_palette
  213.   For I%=0 To 1
  214.     Setcolor I%,Palette%(I%)
  215.   Next I%
  216. Return
  217. '
  218. Procedure Set_color
  219.   Setcolor 0,0
  220.   Setcolor 1,1
  221. Return
  222. '
  223. ' ******************************** DIALOGS *******************************
  224. Procedure Exit_routine
  225.   @Save_alert
  226.   Deftext 0,0,0,32
  227.   Text 106,200,"Do you really want to quit?"
  228.   Showm
  229.   @Check_target
  230. Return
  231. '
  232. Procedure Save_alert
  233.   If First_time%=0
  234.     Deffill 1,2,8
  235.     Pbox 0,112,638,398
  236.     Deffill 0
  237.     Pbox 4,116,634,394
  238.   Endif
  239.   Deffill 1,2,8
  240.   Pbox 10,120,628,390
  241.   Deffill 0,2,8
  242.   Pbox 102,242,238,338
  243.   Pbox 400,242,536,338
  244.   Color 0
  245.   Box 96,236,244,344
  246.   Box 394,236,542,344
  247.   Deffill 1,2,8
  248.   Pbox 104,244,236,336
  249.   Deffill 1,2,8
  250.   Pbox 402,244,534,336
  251.   Deftext 0,0,0,32
  252.   Text 140,300,"Yes!"
  253.   Text 450,300,"No."
  254. Return
  255. '
  256. ' ******************************* SOUNDS *********************************
  257. Procedure Select_sound
  258.   Sound 1,15,6,3,2
  259.   Sound 1,15,6,4,2
  260.   Sound 1,15,8,4,6
  261.   Sound 1,0,0,0,0
  262. Return
  263. '
  264. Procedure Alert_sound
  265.   Sound 1,15,10,3,2
  266.   Sound 1,0,0,0,0
  267. Return
  268. '
  269. Procedure Finale_sound
  270.   Restore Finale_data
  271.   Read N%
  272.   For I%=1 To N%
  273.     Read Nt%,Oct%,Dur%
  274.     Sound 1,15,Nt%,Oct%,Dur%
  275.     Sound 1,0,0,0,0
  276.     Pause 5
  277.   Next I%
  278. Return
  279. '
  280. ' ********************************* DATA *******************************
  281. Finale_data:
  282. Data 7
  283. Data 6,4,16
  284. Data 1,4,8
  285. Data 1,4,8
  286. Data 3,4,16
  287. Data 1,4,32
  288. Data 5,4,16
  289. Data 6,4,64
  290. '
  291.